home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok49 / oprof / txt / hilbert.prf < prev    next >
Text File  |  1993-11-04  |  5KB  |  217 lines
  1. (* OProf ©1990 by Volker Rudolph *)
  2.  
  3. (*
  4.   :Program.       Hilbert
  5.   :Author.        Volker Rudolph
  6.   :Address.       Lettow-Vorbeck-Str. 11 / 6750 Kaiserslautern 26
  7.   :Phone.         06301/8566
  8.   :Version.       1.0
  9.   :Date.          23.7.90
  10.   :Copyright.     PD
  11.   :Language.      Oberon
  12.   :Translator.    Amiga-Oberon V1.14
  13.   :Contents.      Zeichnet Hilbert-Kurven
  14. *)
  15.  
  16.  
  17. MODULE Hilbert;
  18.  
  19. IMPORT  prof:ProfRunTime,e:Exec,i:Intuition,g:Graphics,Break,n:NoGuru,s:SYSTEM;
  20.  
  21. CONST
  22.   ScreenWidth = 350;
  23.   ScreenHeight = 282;
  24.   SquareSize = 256;
  25.  
  26. VAR
  27.   sc:i.ScreenPtr;
  28.   wi:i.WindowPtr;
  29.   msg:e.MsgPortPtr;
  30.  
  31. (* -------------------------------------------------------------------------- *)
  32.  
  33.  
  34. PROCEDURE WaitForClick;
  35. BEGIN
  36.   prof.Entry("Hilbert.WaitForClick",266);
  37. e.WaitPort(wi.userPort);
  38.   msg := e.GetMsg(wi.userPort);
  39.   e.WaitPort(wi.userPort);
  40.   msg := e.GetMsg(wi.userPort);
  41. prof.Exit("Hilbert.WaitForClick",266);
  42. END WaitForClick;
  43.  
  44. PROCEDURE CreateGraphics;
  45. VAR
  46.   ns:i.NewScreen;
  47.   nw:i.NewWindow;
  48. BEGIN
  49.   prof.Entry("Hilbert.CreateGraphics",464);
  50. ns.leftEdge := 0;
  51.   ns.topEdge := 0;
  52.   ns.width := ScreenWidth;
  53.   ns.height := ScreenHeight;
  54.   ns.depth := 3;
  55.   ns.detailPen := 1;
  56.   ns.blockPen := 2;
  57.   ns.viewModes := {};
  58.   ns.type := i.customScreen;
  59.   ns.font := NIL;
  60.   ns.defaultTitle := NIL;
  61.   ns.gadgets := NIL;
  62.   ns.customBitMap := NIL;
  63.   sc := i.OpenScreen(ns);
  64.   n.Assert(sc # NIL,"Can't open screen");
  65.  
  66.   nw.leftEdge := 0;
  67.   nw.topEdge := 0;
  68.   nw.width := ScreenWidth;
  69.   nw.height := ScreenHeight;
  70.   nw.detailPen := 1;
  71.   nw.blockPen := 2;
  72.   nw.idcmpFlags := LONGSET{i.mouseButtons};
  73.   nw.flags := LONGSET{i.borderless};
  74.   nw.firstGadget := NIL;
  75.   nw.checkMark := NIL;
  76.   nw.title := NIL;
  77.   nw.screen := sc;
  78.   nw.bitMap := NIL;
  79.   nw.minWidth := 0;
  80.   nw.minHeight := 0;
  81.   nw.maxWidth := ScreenHeight;
  82.   nw.maxHeight := ScreenHeight;
  83.   nw.type := i.customScreen;
  84.   wi := i.OpenWindow(nw);
  85.   n.Assert(wi # NIL,"Can't open window");
  86.   g.SetRGB4(s.ADR(sc.viewPort),2,15,15,0);
  87. prof.Exit("Hilbert.CreateGraphics",464);
  88. END CreateGraphics;
  89.  
  90. PROCEDURE RemoveGraphics;
  91. BEGIN
  92.   prof.Entry("Hilbert.RemoveGraphics",62);
  93. IF wi # NIL THEN
  94.     i.CloseWindow(wi);
  95.     wi := NIL;
  96.   END; (* IF *)
  97.  
  98.   IF sc # NIL THEN
  99.     i.CloseScreen(sc);
  100.     sc := NIL;
  101.   END; (* IF *)
  102.  
  103. prof.Exit("Hilbert.RemoveGraphics",62);
  104. END RemoveGraphics;
  105.  
  106. PROCEDURE Line(direction,delta:INTEGER);
  107. BEGIN
  108.   prof.Entry("Hilbert.Line",788);
  109. CASE direction OF
  110.     0:g.Draw(wi.rPort,wi.rPort.x+delta,wi.rPort.y);
  111.    |2:g.Draw(wi.rPort,wi.rPort.x,wi.rPort.y-delta);
  112.    |4:g.Draw(wi.rPort,wi.rPort.x-delta,wi.rPort.y);
  113.    |6:g.Draw(wi.rPort,wi.rPort.x,wi.rPort.y+delta);
  114.   ELSE
  115.     n.Assert(FALSE,"Wrong direction");
  116.   END; (* CASE *)
  117.  
  118. prof.Exit("Hilbert.Line",788);
  119. END Line;
  120.  
  121. (* -------------------------------------------------------------------------- *)
  122.  
  123.  
  124. PROCEDURE Hilbert;
  125. VAR
  126.   i,x0,y0,u:INTEGER;
  127.  
  128.   PROCEDURE ^A(i:INTEGER);
  129.   PROCEDURE ^B(i:INTEGER);
  130.   PROCEDURE ^C(i:INTEGER);
  131.   PROCEDURE ^D(i:INTEGER);
  132.  
  133.   PROCEDURE A(i:INTEGER);
  134.   BEGIN
  135.     prof.Entry("Hilbert.Hilbert.A",827);
  136. IF i > 0 THEN
  137.       D(i-1); Line(4,u);
  138.       A(i-1); Line(6,u);
  139.       A(i-1); Line(0,u);
  140.       B(i-1);
  141.     END; (* IF *)
  142.  
  143.   prof.Exit("Hilbert.Hilbert.A",827);
  144. END A;
  145.  
  146.   PROCEDURE B(i:INTEGER);
  147.   BEGIN
  148.     prof.Entry("Hilbert.Hilbert.B",828);
  149. IF i > 0 THEN
  150.       C(i-1); Line(2,u);
  151.       B(i-1); Line(0,u);
  152.       B(i-1); Line(6,u);
  153.       A(i-1);
  154.     END; (* IF *)
  155.  
  156.   prof.Exit("Hilbert.Hilbert.B",828);
  157. END B;
  158.  
  159.   PROCEDURE C(i:INTEGER);
  160.   BEGIN
  161.     prof.Entry("Hilbert.Hilbert.C",829);
  162. IF i > 0 THEN
  163.       B(i-1); Line(0,u);
  164.       C(i-1); Line(2,u);
  165.       C(i-1); Line(4,u);
  166.       D(i-1);
  167.     END; (* IF *)
  168.  
  169.   prof.Exit("Hilbert.Hilbert.C",829);
  170. END C;
  171.  
  172.   PROCEDURE D(i:INTEGER);
  173.   BEGIN
  174.     prof.Entry("Hilbert.Hilbert.D",830);
  175. IF i > 0 THEN
  176.       A(i-1); Line(6,u);
  177.       D(i-1); Line(4,u);
  178.       D(i-1); Line(2,u);
  179.       C(i-1);
  180.     END; (* IF *)
  181.  
  182.   prof.Exit("Hilbert.Hilbert.D",830);
  183. END D;
  184.  
  185. BEGIN
  186.   prof.Entry("Hilbert.Hilbert",47);
  187. x0 := ScreenWidth DIV 2;
  188.   y0 := ScreenHeight DIV 2;
  189.   u := SquareSize;
  190.   i := 0;
  191.   REPEAT
  192.     INC(i);
  193.     u := u DIV 2;
  194.     x0 := x0 + (u DIV 2);
  195.     y0 := y0 + (u DIV 2);
  196.     g.SetAPen(wi.rPort,i);
  197.     g.Move(wi.rPort,x0,ScreenHeight-y0);
  198.     A(i);
  199.     (* WaitForClick; *)
  200.  
  201.   UNTIL (i = 6);
  202. prof.Exit("Hilbert.Hilbert",47);
  203. END Hilbert;
  204.  
  205. (* -------------------------------------------------------------------------- *)
  206.  
  207.  
  208. BEGIN
  209.   prof.Entry("Hilbert",740);
  210. CreateGraphics;
  211.   Hilbert;
  212.   WaitForClick;
  213. prof.Exit("Hilbert",740);
  214. CLOSE
  215.   RemoveGraphics;
  216. END Hilbert.
  217.